home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2001 June / PC-WELT 6_2001.ISO / misc / packdrake < prev    next >
Encoding:
Text File  |  2001-04-18  |  4.3 KB  |  94 lines
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. require packdrake;
  5.  
  6. #- general information.
  7. my $default_size = 400000;
  8. my $default_ratio = 6;
  9.  
  10. sub usage {
  11.     die "packdrake version " . $packdrake::VERSION . "
  12. Copyright (C) 2000 MandrakeSoft.
  13. This is free software and may be redistributed under the terms of the GNU GPL.
  14.  
  15. usage:
  16.   --help                 - print this help message.
  17.   --build <file>         - build archive <file> with filenames given on
  18.                            standard input.
  19.     -[1..9]              - select appropriate compression ratio, $default_ratio by default.
  20.     --dir <srcdir>       - set source directory where to search files, \".\" by default.
  21.     --size <cmd>         - set maximun chunk size, $default_size by default.
  22.     --method <cmd>       - select standard compression command method, default
  23.                            is set according to archive filename, example is
  24.                            /bin/gzip or /usr/bin/bzip2.
  25.     --compress <cmd>     - select compression command.
  26.     --uncompress <cmd>   - select uncompression command.
  27.   --extract <file> <dir> - extract archive <file> contents to directory <dir>,
  28.                            specific file to extract are given on command line.
  29.     --uncompress <cmd>   - override uncompression method in archive <file>.
  30.   --list <file>          - list contents of archive.
  31.   --cat <file>           - dump archive, only supported with gzip and bzip2,
  32.                            this write the contents of all file in archive.
  33. ";
  34. }
  35.  
  36. sub main {
  37.     my ($file, $mode, $dir, $size, $method, $compress, $uncompress, $ratio);
  38.     my @nextargv = (\$file);
  39.     my @list = ();
  40.  
  41.     #- some quite usefull error message.
  42.     my $error_mode = "packdrake: choose only --build, --extract, --list or --cat\n";
  43.     for (@_) {
  44.     /^--help$/       and do { usage; next };
  45.     /^--build$/      and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next };
  46.     /^--extract$/    and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next };
  47.     /^--list$/       and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next };
  48.     /^--cat$/        and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next };
  49.     /^--dir$/        and do { push @nextargv, \$dir; next };
  50.     /^--size$/       and do { push @nextargv, \$size; next };
  51.     /^--method$/     and do { push @nextargv, \$method; next };
  52.     /^--compress$/   and do { push @nextargv, \$compress; next };
  53.     /^--uncompress$/ and do { push @nextargv, \$uncompress; next };
  54.     /^-(.*)$/ and do { foreach (split //, $1) {
  55.         /[1-9]/  and do { $ratio = $_; next };
  56.         /b/      and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next };
  57.         /x/      and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next };
  58.         /l/      and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next };
  59.         /c/      and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next };
  60.         /d/      and do { push @nextargv, \$dir; next };
  61.         /s/      and do { push @nextargv, \$size; next };
  62.         /m/      and do { push @nextargv, \$method; next };
  63.         die "packdrake: unknown option \"-$1\", check usage with --help\n"; } next };
  64.     $mode =~ /extract|list|cat/ or @nextargv or die "packdrake: unknown option \"$_\", check usage with --help\n";
  65.     my $ref = shift @nextargv; $ref ? $$ref = $_ : push @list, $_;
  66.     $mode ||= "list";
  67.     }
  68.  
  69.     #- examine and lauch.
  70.     $file or die "packdrake: no archive filename given, check usage with --help\n";
  71.     $size ||= 400000;
  72.     $ratio ||= 6;
  73.  
  74.     unless ($method) {
  75.     $file =~ /\.cz$/  and $method = "gzip";
  76.     $file =~ /\.cz2$/ and $method = "bzip2";
  77.     }
  78.  
  79.     $compress ||= "$method -$ratio";
  80.     $uncompress ||= "$method -d";
  81.  
  82.     $mode =~ /extract/ && !$dir && !@list and ($mode, @list) = ('list', $file);
  83.     for ($mode) {
  84.     /build/   and do { packdrake::build_archive(\*STDIN, $dir, $file, $size, $compress, $uncompress); last };
  85.     /extract/ and do { my $packer = new packdrake($file); $packer->extract_archive($dir, @list); last };
  86.     /list/    and do { packdrake::list_archive($file, @list); last };
  87.     /cat/     and do { packdrake::cat_archive($file, @list); last };
  88.     die "packdrake: internal error, unable to select right mode?\n";
  89.     }
  90. }
  91.  
  92. #- start the stuff.
  93. main(@ARGV);
  94.